const
	INF:longint = maxlongint;
 
type
	node = record
		v,p,l,r:longint;
		f:boolean;
	end;
 
var
	cc:longint; // nodes count
	a:array[0..100010] of node;

function root():longint;
begin
if a[0].r < INF then result := a[0].r else result := a[0].l;
end;

function children(t:longint):longint;
begin
result := byte(a[t].l < INF) + byte(a[t].r < INF);
end;

procedure print(v:longint);

var
	h,t,cur,vv:longint;
	q:array[0..100,1..2] of longint;

begin
writeln;
fillchar(q,sizeof(q),0);
h := 1;
t := 1;
q[1][1] := v;
q[1][2] := 0;
cur := 0;
while h <= t do begin
	vv := q[h][1];
	if not a[vv].f then inc(vv);
	if q[h][2] > cur then begin
		inc(cur);
		writeln;
	end;
	if a[vv].l < INF then begin
		inc(t);
		q[t][1] := a[vv].l;
		q[t][2] := q[h][2] + 1;
	end;
	if a[vv].r < INF then begin
		inc(t);
		q[t][1] := a[vv].r;
		q[t][2] := q[h][2] + 1;
	end;
	write(a[a[vv].p].v,'->',a[vv].v, ' ');
	inc(h);
end;
writeln;
end;
 
function search(v:longint):longint;
 
var
	i:longint;
 
begin
result := 0;
i := root();
while i <= cc do begin
	result := i;
	if v = a[i].v then exit;
	if v > a[i].v then i := a[i].r else i := a[i].l;
end;
end;
 
procedure add(v:longint);
 
var
	t:longint;
 
begin
t := search(v);
if a[t].v = v then exit;
inc(cc);
a[cc].v := v; 
a[cc].p := t;
a[cc].l := INF;
a[cc].r := INF;
a[cc].f := true;
if v > a[t].v then a[t].r := cc else a[t].l := cc;
end;
 
function height(n:longint):longint;
 
var
	t,k:longint;
 
begin
if a[n].l < INF then k := height(a[n].l) else k := 0;
if a[n].r < INF then t := height(a[n].r) else t := 0;
result := max(k, t) + 1;
end;

procedure delete(v:longint);

var
	t,kk,p,tt,l,r:longint;

begin
t := search(v);
if a[t].v <> v then exit;
a[t].f := false;
kk := children(t);
p := a[t].p;    
l := a[t].l;
r := a[t].r;
if kk = 0 then begin
	if v > a[p].v then a[p].r := INF else a[p].l := INF;
end else
if kk = 1 then begin
	if v > a[p].v then begin
		if r < INF then begin
			a[p].r := r;
			a[r].p := p;
		end else begin
			a[p].r := l;
			a[l].p := p;
		end;
	end else begin
		if r < INF then begin
			a[p].l := r;
			a[r].p := p;
		end else begin
			a[p].l := l;
			a[l].p := p;
		end;
	end;
end else begin
	if v > a[p].v then a[p].r := l else a[p].l := l;
	a[l].p := p;
	tt := l;
	while a[tt].r < INF do tt := a[tt].r;
	a[tt].r := r;
	a[r].p := tt;
end;
end;

procedure rotateLeft(t:longint);

var
	r,p:longint;

begin
r := a[t].r;
p := a[t].p;
if r = INF then exit;
a[t].r := INF;
if a[r].l < INF then begin
	a[a[r].l].p := t;
	a[t].r := a[r].l;
end;
if a[t].v > a[p].v then a[p].r := r else a[p].l := r;
a[r].p := p;
a[t].p := r;
a[r].l := t;
end;

procedure rotateRight(t:longint);

var
	l,p:longint;

begin
l := a[t].l;
p := a[t].p;
if l = INF then exit;
a[t].l := INF;
if a[l].r < INF then begin
	a[a[l].r].p := t;
	a[t].l := a[l].r;
end;
if a[t].v > a[p].v then a[p].r := l else a[p].l := l;
a[l].p := p;
a[t].p := l;
a[l].r := t;
end; 

procedure balance();

var
	x,t,i,cur,kk:longint;
	tmp:array[0..110] of longint;
	w:array[0..110] of boolean;

begin
fillchar(w,sizeof(w),0);
x := root();
while children(x) > 0 do begin
	if a[x].r < INF then begin
		rotateLeft(x);
		x := a[x].p;
	end else x := a[x].l;
end;
t := 1;
while t <= cc do t := t shl 1;
if (cc + 1) and cc = 0 then t := 0 else t := cc - t shr 1 + 1;
x := root();
for i := 1 to t do begin
	rotateRight(x);
	x := a[a[x].p].l;
end;
while true do begin
	x := root();
	kk := 0;
	cur := 0;
	while x < INF do begin
		inc(cur);
		if odd(cur) and (not w[x]) then begin
			inc(kk);
			tmp[kk] := x;
			w[x] := true;
		end;
		x := a[x].l;
	end;
	dec(kk);
	if kk < 1 then break;
	for i := 1 to kk do 
		rotateRight(tmp[i]);
end;
end;
